General

Column

Target



Qual área de pesquisa é emergente?



Qual pesquisador contratar?



Qual patente comprar?



Growth

Groups Growth

Groups Description

Column

Shelf Life



Adicionar uma sentença sobre Shelf Life, para catecterizar a área de pesquisa.



  • Shelf Life
  • 13,516 Registers
  • 12.9% Growth Rate
  • 5.6 Years Doubling Time



  • Scopus
  • 52,000,000 Registers
  • 4.13% Growth Rate
  • 17 Years Doubling Time

Segmented Growth

Networks

Groups Attributes

g01

Em construção.

g02

Em construção.

g03

Em construção.

g04

Em construção.

Conclusions

Escrever algum texto para finalizar a análise.

---
title: "A4F - Shelf Life"
output: 
  flexdashboard::flex_dashboard:
    navbar:
      - { title: "Research", href: "http://roneyfraga.com/dash/2020_A4F", align: right }
      - { title: "People", href: "http://roneyfraga.com/dash/2020_A4F/#pessoas", align: right }
      - { title: "Patent", href: "http://roneyfraga.com/dash/2020_A4F/#pessoas", align: right }
      - { title: "About", href: "http://roneyfraga.com/", align: right }
    social: [ "menu" ]
    source_code: "embed"
    theme: bootstrap #yeti #lumen
    logo: img/logo.png
---

```{r setup, include=FALSE}
options(scipen=999)
library(rmarkdown)
library(flexdashboard)
library(pipeR)
library(tidyverse)
library(rio)
library(ggraph)
library(tidygraph)
library(DT)
library(plotly)
library(visNetwork)
library(igraph)
library(ggthemes)
library(highcharter)
library(lubridate)
library(sparkline)
library(htmlwidgets)
library(printr)
```

# General 


Column {data-width=500 .tabset}
-------------------------------------


### Target



Qual área de pesquisa é emergente?



Qual pesquisador contratar?



Qual patente comprar?



### Growth ```{r} # graphics import('data/shelf_life_growth.txt') %>>% as_tibble %>>% rename(PY = V1, publications = V2 ) %>>% dplyr::filter(PY %in% c(1980:2019)) %>>% dplyr::arrange(PY) %>>% dplyr::mutate(trend=1:n()) %>>% (. -> d) # export(d, '~/OneDrive/Rworkspace/SASUniversityEdition/myfolder/shelf_life/shelf_life.csv') d$lnp <- log(d$publications) # ajustar parametros via mqo m1 <- lm(lnp ~ trend, data=d) # summary(m1) beta0 <- m1$coefficients[[1]] beta1 <- m1$coefficients[[2]] # modelo não linear # 1980 é o primeiro ano da série m2 <- nls(publications ~ b0*exp(b1*(PY-1980)), start = list(b0=beta0, b1=beta1), data=d) # publications estimado d$predicted <- 12.159638*exp(0.121922*(d$PY-1980)) d %>>% mutate(Publications=publications, Year=PY) %>>% mutate(predicted=round(predicted,0)) %>>% (. -> d2) hchart(d2, "column", hcaes(x = Year, y = Publications), name = "Publications", showInLegend = TRUE) %>>% hc_add_series(d2, "line", hcaes(x = Year, y = predicted), name = "Predicted", showInLegend = TRUE) %>>% hc_add_theme(hc_theme_elementary()) %>>% hc_navigator( enabled = TRUE) ``` ### Groups Growth ```{r} netcoup <- import('data/netcoup.rds') a <- import('data/netcoup_grupos.rds') netcoup %>>% activate(nodes) %>>% as_tibble %>>% dplyr::filter(!is.na(grupo)) %>>% group_by(PY,grupo) %>>% tally(sort=TRUE) %>>% arrange(grupo,desc(PY)) %>>% ungroup %>>% dplyr::filter(PY %in% c(2000:2019)) %>>% dplyr::mutate(Group=grupo,Publications = n, Year = PY) %>>% (. -> grupoAno) hchart(grupoAno, "line", hcaes(x = Year, y = Publications, group = Group), fillOpacity = 0.2) %>>% hc_add_theme(hc_theme_elementary()) %>>% hc_navigator( enabled = TRUE) ``` ### Groups Description ```{r} data.frame(Group=paste0('g',1:13),Description='algum texto para descrever o grupo') %>>% datatable(options=list(pageLength=13, dom = 'tip'), rownames=F) ``` Column {data-width=500 .tabset} ------------------------------------- ### Shelf Life

Adicionar uma sentença sobre Shelf Life, para catecterizar a área de pesquisa.



> - __Shelf Life__ > - 13,516 Registers \n > - 12.9% Growth Rate \n > - 5.6 Years Doubling Time \n

> - __Scopus__ > - 52,000,000 Registers \n > - 4.13% Growth Rate \n > - 17 Years Doubling Time \n > ### Segmented Growth ```{r, out.width='75%'} # graphics import('data/shelf_life_growth.txt') %>>% as_tibble %>>% rename(PY = V1, publications = V2 ) %>>% dplyr::filter(PY %in% c(1980:2019)) %>>% dplyr::arrange(PY) %>>% dplyr::mutate(trend=1:n()) %>>% (. -> d) d$lnp <- log(d$publications) PY <- d$PY d$est <- ifelse(PY <= 1986.0, -441.3+(0.2239)*PY, ifelse(PY<=1992.0, -441.3 + (0.2239)*1986.0 + 0.0511*(PY-1986.0), ifelse(PY<=2004.8, -441.3 + (0.2239)*1986.0 + 0.0511*(1992.0-1986.0) + 0.1510*(PY-1992.0), -441.3 + (0.2239)*1986.0 + 0.0511*(1992.0-1986.0) + 0.1510*(2004.8-1992.0) + 0.1186*(PY-2004.8) ))) d %>>% mutate(ln_Publications=lnp, Year=PY) %>>% mutate(ln_Publications=round(ln_Publications,2), est=round(est,2)) %>>% (. -> d2) hchart(d2, "line", hcaes(x = Year, y = ln_Publications), name = "Publications", showInLegend = TRUE, fillOpacity = 0.2) %>>% hc_add_series(d2, "line", hcaes(x = Year, y = est), name = "Segmented Regression", showInLegend = TRUE, fillOpacity = 0.2) %>>% hc_add_theme(hc_theme_elementary()) %>>% hc_navigator( enabled = TRUE) %>>% hc_xAxis( plotBands = list( list( from = 1986, to = 1986, color = "#330000" ), list( from = 1992, to = 1992, color = "#330000" ), list( from = 2004, to = 2004, color = "#330000" ) )) ``` ### Networks ```{r} netcoup <- import('data/netcoup.rds') hubs <- import('data/netcoup_hubs.rds') hubs %>>% select(SR,Ki) %>>% (. -> hubs2) netcoup %>>% activate(nodes) %>>% left_join(hubs2) %>>% (. -> netcoup) # ALTERAR AQUI ano <- 1990 netcoup %>>% as_tbl_graph() %>>% activate(nodes) %>>% mutate(label=name) %>>% mutate(label=paste( gsub(' .*$','',label), gsub('.*\\.','',label), sep='' )) %>>% dplyr::filter(!is.na(grupo)) %>>% dplyr::filter(PY <= ano) %>>% (. -> netcoup2) tibble(id=1:length(V(netcoup2)), label= V(netcoup2)$label, group=V(netcoup2)$grupo, year=V(netcoup2)$PY ) %>>% (. -> nodes) tibble(from = netcoup2 %>>% activate(edges) %>>% as_tibble %>>% pull(from), to = netcoup2 %>>% activate(edges) %>>% as_tibble %>>% pull(to) ) %>>% (. -> edges) visNetwork(nodes, edges, height = "700px", width = "100%", main = as.character(max(V(netcoup2)$PY))) %>% visNodes(size = 10, shape='dot') %>>% visEdges(width = 2, hidden=F) %>>% visOptions(selectedBy = "group", highlightNearest = TRUE, nodesIdSelection = F) %>>% visPhysics(stabilization = T) %>>% visGroups(groupname = "g01", color = "#38501e") %>>% visGroups(groupname = "g02", color = "#23331e") %>>% visGroups(groupname = "g03", color = "#6e1d21") %>>% visGroups(groupname = "g04", color = "#472926") %>>% visGroups(groupname = "g05", color = "#926433") %>>% visGroups(groupname = "g06", color = "#a90a26") %>>% visGroups(groupname = "g07", color = "#97863e") %>>% visGroups(groupname = "g08", color = "#00FFFF") %>>% visGroups(groupname = "g09", color = "#d48d01") %>>% visGroups(groupname = "g10", color = "#021338") %>>% visGroups(groupname = "g11", color = "#e6d82e") %>>% visGroups(groupname = "g12", color = "#9eb739") %>>% visGroups(groupname = "g13", color = "#808080") ``` ### Groups Attributes ```{r} grupos <- sort(unique(grupoAno$Group)) # grupos <- grupos[1:3] res <- vector('double', length(grupos)) for(i in seq_along(grupos)){ grupoAno %>>% dplyr::select(PY,n,Group) %>>% dplyr::rename(publications = n) %>>% dplyr::filter(PY >= 2000) %>>% dplyr::arrange(PY) %>>% dplyr::filter(Group==grupos[[i]]) %>>% dplyr::mutate(trend=1:n()) %>>% dplyr::mutate(lnp=log(publications)) %>>% (. -> d) # ajustar parametros via mqo m1 <- lm(lnp ~ trend, data=d) beta0 <- m1$coefficients[[1]] beta1 <- m1$coefficients[[2]] # modelo não linear m2 <- nls(publications ~ b0*exp(b1*(PY-2010)), start = list(b0=beta0, b1=beta1), data=d) res[[i]] <- coef(m2)[2] } # print(xtable(grupoAnoCrescimento, type = "latex")) data.frame(Groups=grupos,Coef=res) %>>% as_tibble %>>% mutate(GrowthRateYear=(exp(Coef)-1)*100) %>>% dplyr::select(-Coef) %>>% left_join(import('data/netcoup_grupos.rds') %>>% select(nname,qtde.papers,PY.m) %>>% rename(Groups = nname)) %>>% dplyr::arrange(Groups) %>>% (. -> grupoAnoCrescimento) %>>% dplyr::rename(AverageAge = PY.m) %>>% dplyr::rename(TotalPapers = qtde.papers) %>>% mutate(AverageAge = round(AverageAge,1)) %>>% left_join(import('data/ZiPi.rds') %>>% mutate(Groups=grupo) %>>% select(Groups,Hubs)) %>>% mutate(Description='Adicionar a descrição do grupo. Manter um texto o mais explicativo possível.') %>>% relocate(Description, .after=Groups) %>>% select(-Description) %>>% rename(Group = Groups) %>>% datatable(options=list(pageLength=13, dom = 'tip'), rownames=F) %>>% formatRound('GrowthRateYear',1) ``` # g01 {data-navmenu="Groups"} Em construção. # g02 {data-navmenu="Groups"} Em construção. # g03 {data-navmenu="Groups"} Em construção. # g04 {data-navmenu="Groups"} Em construção. # Conclusions Escrever algum texto para finalizar a análise. # Pessoas {.hidden} Em construção. # Patentes {.hidden} Em construção.